perm filename CV[TMP,LCS] blob
sn#502612 filedate 1980-03-13 generic text, type T, neo UTF8
;;XINI: SKIPN GO
XINI: JRST PASSD
; OUTSTR [ASCIZ /LENGTH IN INCHES (Y DIMENSION, DEFAULT=10)? /]
; SETZM DEFA#
; SKIPE GO
; JRST PASSD
; PUSHJ P,RNUM
; SETOM DEFA; ; ;ASSUME 10 INCHES
; JUMPLE A,[XINLER:INCHWL 0 ; GET LF?
; JRST XINI]
; SKIPGE DEFA; ; ;? GO?
PASSD: HRRZI A,=10
; SKIPE GO
; MOVE A,GO
; CAIE C,12
; JRST XINLER
IMULI A,=200
CAILE A,=2000 ;IF MORE THAN 10" IS TYPED, WE GET 10"
MOVEI A,=2000 ;THIS IS MAXIMUM FOR THIS PROGRAM(255K)
PUSH P,A
PASS3: MOVEI A,=0
IYDEF: MOVEM A,SHIFT# ;A MINUS NUMBER SHIFTS IMAGE DOWN OFF PAGE
;; PUSHJ P,NAMGET ;GET OUTPUT NAME
;; MOVE A,SHIFT
POP P,A
XDEF: MOVEM A,LINCNT#
MOVEI B,-1(A)
IMULI A,LBUFL+1 ;A← BUFSIZ ← ROWS * COL
MOVE T,JOBFF ;GET START ADDR
MOVEM T,XGPPTR
SOS XGPPTR
MOVEI T,2(A)
MOVNI TT,(T)
ADD T,XGPPTR
HRLM TT,XGPPTR ;XGPPTR← -WDCNT,,ADDR-1
MOVE TT,T
HRRZ L,XGPPTR
MOVSI T,1(L)
HRRI T,2(L)
SETZM 1(L)
MOVE U,JOBREL
BLT T,(U) ;ZERO TO END OF CORE
HRRZI U,(TT)
MOVEM B,SVBBB#
;; MOVE Y,IYPOS
;; ADDI Y,2(L)
MOVEI Y,2(L)
MOVEI XD,DBUF+1
SKIPL A,INIX ;WHERE DO WE START
JRST MAYBON
SUBI A,43
IDIV A,[-44]
HRLOI X,XD
SOJA A,SETB
MAYBON: ADDI A,43
IDIVI A,44
CAILE A,LBUFL
JRST OFFRT
MOVE X,A
SETZ A,
HRLI X,Y
JRST SETB
OFFRT: MOVE X,[XD,,LBUFL]
SUBI A,LBUFL
SETB: MOVE B,INIX
IDIVI B,44
MOVSI B,400000
MOVN C,C
ROT B,(C)
POPJ P,
POPJ1: AOS (P)
CPOPJ: POPJ P,
LFT: -=100
RT: =1700
BOT: -=1229
TOP: =2971
OFFX: -=921
OFFY: =1700
NOROT: 0
SVX: 0
SVY: 0
SVPEN: 0
X1: 0
Y1: 0
3
CLIP: PUSHJ P,SAVAC ;SAVE ALL AC'S.
MOVE CX# ;5 X1=CX
MOVEM X1#
MOVE CY# ; Y1=CY
MOVEM Y1#
MOVEM 15,CX ; CX=X2 (SVX)
MOVE SVY ; CY=Y2 (SVY)
MOVEM CY
;;; JSA 16,ALLOUT
ALLOUT: MOVE 1,LFT ;LFT - FOR OUT OF BOUNDS USE 1400 SIZE.
CAMLE 1,X1
CAMG 1,SVX
SKIPA
JRST AA1
MOVE 1,RT
CAMGE 1,X1
CAML 1,SVX
SKIPA
JRST AA1
MOVE 1,BOT
CAMLE 1,Y1
CAMG 1,SVY
SKIPA
JRST AA1
MOVE 1,TOP
CAMGE 1,Y1
CAML 1,SVY
JRST ALLIN ;JRST AA2
AA1: PUSHJ P,GETAC ;GET BACK AC'S
JRST ENOUT ;SETZ
; JRST YYY1 ;IF(VECPOS(K))1,400,300
;AA2: SETO
;; SKIPN ;=0 = OUT
;; JRST YYY1 ;ALL OUT OF BOUNDS
;;; JSA 16,ALLIN
;;; JUMP X1
;;; JUMP SVX
;;; JUMP Y1
;;; JUMP SVY
;;; SKIPN ;=0 = IN =-1 = PART OUT
;ALLIN: 0 ;CALL ALLIN(I,J,K,L)
; SETO ;ALLIN=-1
ALLIN: MOVE 1,X1 ;I
CAML 1,LFT
CAMLE 1,RT
JRST ALX ;**** JRA 16,4(16)
MOVE 1,SVX
CAML 1,LFT
CAMLE 1,RT
JRST ALX ;**** JRA 16,4(16)
MOVE 1,Y1
CAML 1,BOT
CAMLE 1,TOP
JRST ALX ;**** JRA 16,4(16)
MOVE 1,SVY
CAML 1,BOT
CAMLE 1,TOP
JRST ALX ;**** JRA 16,4(16)
JRST V400 ;**** SETZ ;ALLIN=0
;**** JRA 16,4(16)
;**** JRA 16,1(16)
ALX: MOVE Y1 ;IF(Y1.EQ.Y2)GO TO V50
CAMN SVY
JRST V50
MOVE X1 ;IF(X1.NE.X2)GO TO V60
CAME SVX
JRST V60
JSA 16,STRT
JUMP Y1
JUMP SVY ;Y2
JUMP BOT
JUMP TOP
JRST V300
V50: JSA 16,STRT
JUMP X1
JUMP SVX
JUMP LFT
JUMP RT
JRST V300
;V300: MOVEI 1 ; MAKE AC0 +1
; JRA 16,1(16) ; JUMPS TO 300 IN MAIN PROG.
V60: JSA 16,CL
JUMP X1
JUMP SVX
JUMP Y1
JUMP SVY ;Y2
JUMP W1#
JUMP W2#
JUMP Z1#
JUMP Z2#
JUMP LFT
JUMP RT
YYOUT: MOVE 1,BOT
CAMLE 1,Y1
CAMG 1,SVY
SKIPA
JRST AA1 ;JRST YYY1
MOVE 1,TOP
CAMGE 1,Y1
CAML 1,SVY
JRST CLXX
JRST AA1 ;SKIP THIS VECTOR
;;YYY1: SETO
;; JRA 16,1(16)
CLXX: JSA 16,CL
JUMP Z1#
JUMP Z2#
JUMP W1#
JUMP W2#
JUMP Y1 ;Y1
JUMP SVY ;Y2
JUMP X1 ;X1
JUMP SVX ;X2
JUMP BOT
JUMP TOP
V300: MOVE SVPEN ;IF(K.EQ.3)GO TO 400;; JRST V300
CAIN 3
JRST V400
MOVE X1 ; IF(X1.NE.X3)GO TO 500
CAME X3# ; IF(Y1.EQ.Y3)GO TO 400
JRST V500 ;500 CALL VECOU(MM,LL,JX)
MOVE Y1 ;400 X3=X2
CAMN Y3# ; Y3=Y2
JRST V400
V500: MOVE SVX
MOVEM X3
MOVE SVY
MOVEM Y3
MOVE SVPEN
MOVEM SVPN#
MOVE X1
MOVEM SVX
MOVE Y1
MOVEM SVY
MOVEI 3
MOVEM SVPEN
PUSHJ P,GETAC ; CALL VECOU(MM,LL,JX)
PUSHJ P,VECOU ; MAKE AN INVISIBLE VECTOR
PUSHJ P,SAVAC
MOVE X3
MOVEM SVX ;GET BACK READ X,Y
MOVE Y3
MOVEM SVY
MOVE SVPN
MOVEM SVPEN
JRST V401
V400: MOVE SVX
MOVEM X3
MOVE SVY
MOVEM Y3
V401: PUSHJ P,GETAC
PUSHJ P,VECOU
JRST ENOUT ; GO TO 1
CL: 0
MOVE 10,@(16) ;X1
MOVE 11,@1(16) ;X2
MOVE 15,11
SUB 15,10
FLTR 15,15 ;R
; MOVE 12,@2(16) ;Y1
MOVE 14,@3(16) ;Y2
SUB 14,@2(16) ;Q=(Y2-Y1)/(X2-X1)
FLTR 14,14
FDVR 14,15 ;Q
QX: MOVE 1,10 ;W1=X1
CAMGE 10,@10(16) ;IF(X1.LT.LFT)W1=LFT
MOVE 1,@10(16)
CAMLE 10,@11(16) ;IF(X1.GT.RT)W1=RT
MOVE 1,@11(16) ;W1 IS AC1
W1X: MOVEM 1,@4(16)
SUB 1,10 ;W1-X1
FLTR 1,1
FMPR 1,14 ;*Q
MOVE [0.5]
SKIPGE 1
MOVNS
FADR 1,0 ;ROUNDOFF
KIFIX 1,1
ADD 1,@2(16) ;+Y1
MOVEM 1,@6(16)
Z1X: MOVE 1,11 ;W2=X2
CAMGE 11,@10(16)
MOVE 1,@10(16)
CAMLE 11,@11(16)
MOVE 1,@11(16) ;W2 IS AC1
MOVEM 1,@5(16)
W2X: SUB 1,11 ;X2-W2
FLTR 1,1
FMPR 1,14 ;*Q
MOVE [0.5]
SKIPGE 1
MOVNS
FADR 1,0 ;ROUNDOFF
KIFIX 1,1
ADD 1,@3(16) ;Y2-Q*(X2-W2)
MOVEM 1,@7(16) ;Z2
Z2X: JRA 16,12(16)
STRT: 0
MOVE 1,@2(16) ;CALL STRT(X1,X2,LFT,RT)
MOVE 2,@3(16) ; NOW CHECK RIGHT (OR TOP) SIDE.
CAMG 1,@(16)
JRST ST1
MOVEM 1,@(16)
JRST ST3
ST1: CAMLE 1,@1(16)
MOVEM 1,@1(16)
ST2: CAML 2,@(16)
JRST ST3
MOVEM 2,@(16)
JRA 16,4(16)
ST3: CAMGE 2,@1(16)
MOVEM 2,@1(16)
JRA 16,4(16)
PLOT: HRR C,IBUF+1
MOVN E,1(C) ;FIX FOR NO WDCNT
PLOTX: MOVSI E,(E)
HRR E,IBUF+1
PLOT1: MOVE 14,2(E)
LSHC 14,-10
ASH 15,-34
JUMPG 15,NORSET ;NEXT FOR RESET OF COORDS TO 0,0 (SVPEN=-1)
LSHC 14,-16
ASH 15,-26
MOVN 14,15 ;TOP=TOP-Y2
ADDM 14,TOP
ADDM 14,BOT ;BOT=BOT-Y2
ADDM 15,OFFX
SKIPE NOROT ;IF(NOROT)OFFY=OFFY+Y2
ADDM 15,OFFY
JRST ENOUT ;GO GET ANOTHER POINT
NORSET: MOVEM 15,SVPEN# ;GET PEN CODE - NO RESET
MOVM A,15
LSHC 14,-16
ASH 15,-26
SSSS: MOVEM 15,SVY# ;GET Y
LSHC 14,-16
ASH 15,-26
MOVEM 15,SVX# ;GET X
JRST CLIP
VECOU: AOS NOVECS ;COUNTS VECTORS
MOVE 14,OFFY ;IF(NOROT)GO TO VEC1 IF SIZE 2.1-2.6
SKIPE NOROT#
JRST VEC1
MOVE 13,SVY ;N=Y+OFFX
ADD 13,OFFX
SUB 14,SVX ;K2=OFFY-X
MOVEM 14,SVY ;Y=K2
MOVEM 13,SVX
JRST VEC2
;;VEC1: MOVE 13,SVX
VEC1: ADDB 14,SVY ;Y=Y+OFFY
VEC2: MOVE 15,SVY ;X=N
SUB 15,YY
MOVEM 15,SVYSB# ;SAVE Y DIFF
IMULI 15,LBUFL+1
ADD 15,Y
CAMGE 15,[=262144] ;2↑18
SKIPG 15 ;IF(AC15.LT.0.OR.AC15.GT.2↑18-1)SKIP THIS POINT
POPJ P, ;JRST ENOUT ;GO ON TO NEXT POINT, THIS WON'T FIT IN 1/2 WD.
YOK: MOVEM 15,SVYOD# ;SAVE NEW Y
CAIGE 15,(L) ;OFF BOTTOM
JRST LOSE
CAIL 15,-LBUFL-1(U) ;OFF TOP
JRST LOSE
MOVE 15,SVX
SUB 15,XX
MOVE 0,15 ;0 HAS X DIFF
HRRZ 16,X
IMULI 16,44 ;TIMES BITS INA WORD
JFFO B,.+1
ADD 16,C ;PLUS REMAINDER EQ OLD X
SUB 16,15
JUMPL 16,LOSEX
CAILE 16,=4427
JRST LOSEX
SKIPE OOBFLG# ;CK IF ALREADY OOB
JRST OOBAR
FIXUP: CAIE A,1 ;FIXUP WHAT?
HRRM A,PENN
HRR A,PENN ;SAME PEN IF 1
CAIN A,3
JRST PENUP ;PENUP IF 3
MOVE C,SVYSB ;Y DIFF
IORM B,@X ;MARK NOW X Y
;FIND DIRECTION
JUMPE NORMX ;VERT OR NO MOVE
JUMPL MVLFT ;LEFT
JUMPE C,NRT ;HORZ
JUMPL C,MVDWN ;DOWN
CAMLE C,0 ;JUMP IF Y DIFF > X DIFF
JRST XCHA
SETZ 14, ;↓↓ MOVE UP AND RIGHT
TLNE C,200000
JRST .+4
LSH C,1
TRO C,1
AOJA 14,.-4
SUBI 14,=34
IDIV C,0
MOVNS 14
LSH C,(14)
SETZ 15,
INLOOP: ADD 15,C
TLZE 15,200000
ADDI Y,LBUFL+1
SKIPGE B
SOJ X,
ROT B,1
IORM B,@X
SOJG INLOOP
JRST DONXT
XCHA: SETZ 14, ;↓↓MOVE UP AND RIGHT
TLNE 0,200000
JRST .+4
LSH 0,1
TRO 0,1
AOJA 14,.-4
SUBI 14,=34
IDIV 0,C
MOVNS 14
LSH 0,(14)
SETZ 15,
INLOO: ADD 15,0
TLZN 15,200000
JRST MVUP
SKIPGE B
SOJ X,
ROT B,1
MVUP: ADDI Y,LBUFL+1
IORM B,@X
SOJG C,INLOO
JRST DONXT
MVDWN: MOVMS C ;↓↓MOVE DOWN AND RIGHT
CAMLE C,0
JRST XCHA2 ;JUMP IF YDIFF > XDIFF
SETZ 14,
TLNE C,200000
JRST .+4
LSH C,1
TRO C,1
AOJA 14,.-4
SUBI 14,=34
IDIV C,0
MOVNS 14
LSH C,(14)
SETZ 15,
INLOP: ADD 15,C
TLZE 15,200000
SUBI Y,LBUFL+1
SKIPGE B
SOJ X,
ROT B,1
IORM B,@X
SOJG INLOP
JRST DONXT
XCHA2: SETZ 14, ;↓↓MOVE DOWN AND RIGHT
TLNE 0,200000
JRST .+4
LSH 0,1
TRO 0,1
AOJA 14,.-4
SUBI 14,=34
IDIV 0,C
MOVNS 14
LSH 0,(14)
SETZ 15,
INOOP: ADD 15,0
TLZN 15,200000
JRST MVEX
SKIPGE B
SOJ X,
ROT B,1
MVEX: SUBI Y,LBUFL+1
IORM B,@X
SOJG C,INOOP
JRST DONXT
NRT: JUMPL B,GOOP ;HORZ RIGHT
TOOT: ROT B,1
IORM B,@X
SOJG 0,NRT
JRST DONXT
GOOP: SOJ X,
CAIGE 0,44
JRST TOOT
IDIVI 0,44
SETOM @X
SOJ X,
SOJG 0,.-2
HRR 0,1
JUMPN 0,TOOT
AOJ X,
JRST DONXT
NLFT: MOVMS 0 ;HORZ LEFT
ROT B,-1
JUMPL B,ROOT
WOOP: IORM B,@X
SOJG 0,.-3
JRST DONXT
ROOT: AOJ X,
CAIGE 0,44
JRST WOOP
IDIVI 0,44
SETOM @X
AOJ X,
SOJG 0,.-2
HRR 0,1
JUMPN 0,WOOP
SOJ X,
ROT B,1
JRST DONXT
;;NORMX: JUMPE C,NOMOVE ;NO DIFF
NORMX: SKIPN C ;;JUMPE C,ENOUT ;NO DIFF
POPJ P,
JUMPL C,MDOWN ;MOVE VERT DOWN
MUP: ADDI Y,LBUFL+1 ;MOVE VERT UP
IORM B,@X
SOJG C,MUP
JRST DONXT
MDOWN: SUBI Y,LBUFL+1 ;MOVE VERT DOWN
IORM B,@X
AOJL C,MDOWN
DONXT: MOVE 4,SVX ;DONE. NOW UPDATE X AND Y
MOVEM 4,XX
NXTY: MOVE 4,SVY
MOVEM 4,YY
;;NOMOVE: SKIPL SVPEN ;****** THIS DONE AT 'PLOT' NOW
;; JRST ENOUT
;; SETZM XX ;IF NEW LOCO
;; SETZM YY
POPJ P,
;;ENOUT: SKIPN CLIPX ;IF CLIPX.EQ.0 WE ARE INSERTING INVIS VEC.
;; JRST CLIPZ
ENOUT: AOBJN E,PLOT1 ;GET NEXT
JRST OUTER